home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / SUTILS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-23  |  6KB  |  207 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'database.int'}
  8. {$include: 'load.int'}
  9. {$include: 'sutils.int'}
  10.  
  11. IMPLEMENTATION OF sutils;
  12.  
  13. {DLX Bulletin Board System V7.0
  14.  
  15.  FREEWARE NOTICE
  16.  
  17.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  18.  Anyone who wishes to may run the program, copy it, or modify it for
  19.  any purpose, including commercial gain.}
  20.  
  21. USES types,globals,utils,database,load;
  22.  
  23. {***INTERFACE TO THE PASASM ASSEMBLER UTILITIES PACKAGE***}
  24. {$include: 'pasasm.int'}
  25.  
  26. {Send a private mail message to user number q[wx].correspondent.
  27.  q[wx].send_line_count must be set to the number of lines in the message
  28.  body (don't count the 4 lines of the header).
  29.  Returns true if it succeeds and false if it fails.
  30.  The message is the linked list headed by q[wx].msg_first.
  31.  sendmsg frees the list if it succeeds.}
  32. function sendmsg {boolean};
  33. var
  34.   i : integer;
  35.   p : para;
  36.   h : mailhead;
  37.   str : lstring(80);
  38. begin
  39.   sendmsg:=false;
  40.  
  41.   {determine whether target is online or not}
  42.   i:=on_line(q[wx].correspondent);
  43.   if i>=0 then {target is online}
  44.     [if ((q[i].state=display_file) and (q[i].return_state=whoelse))
  45.     or else q[i].state in [top..got_pw,
  46.                    news..msgs_4u,
  47.                    mail_gimme1..mail_gimme1j,
  48.                    snip..dummy] then
  49.     {don't interrupt target if she's receiving mail or exiting}
  50.     return
  51.  
  52.      else {target is online and it's ok to send her mail}
  53.        [q[i].mail_mod:=true;
  54.  
  55.         {get ptr to last line of message}
  56.         p:=q[wx].msg_first;
  57.     while p<>nill and then p^.link<>nill do p:=p^.link;
  58.     q[wx].msg_last:=p;
  59.  
  60.     {prepare new mail head and point it to our message}
  61.     newhead(h); h^.head_link:=nil; h^.deleted:=false;
  62.     h^.text_first:=q[wx].msg_first; h^.text_last:=q[wx].msg_last;
  63.     q[wx].msg_first:=nill; q[wx].msg_last:=nill;
  64.  
  65.         {put it in target's online mailbox}
  66.     if q[i].mbx_first=nil then
  67.       [h^.index:=1; q[i].mbx_first:=h; q[i].mbx_last:=h]
  68.     else
  69.       [h^.index:=q[i].mbx_last^.index+1;
  70.        q[i].mbx_last^.head_link:=h; q[i].mbx_last:=h];
  71.  
  72.     {bump target's message count}
  73.     if encode(str,(ivalue(q[i].my.mbx_count)+1):1)
  74.       then kopystr(str,q[i].my.mbx_count);
  75.  
  76.         if q[i].my.chat_ok[1]<>'P' then notify(i,new_mail_txt)]]
  77.  
  78.   else {target is not online -- append to her mail file}
  79.     [mbx(mailpath,q[wx].your.userid,str); {construct target's mail filename}
  80.  
  81.      {open file for append access}
  82.      q[wx].handle:=mult_open(str,0);
  83.      if q[wx].handle<=0 or else
  84.     (not encode(str,(q[wx].send_line_count+4):3)) then
  85.        {someone else is sending mail}
  86.        return;
  87.  
  88.      {write the message, disposing as we go}
  89.      mail_writeln(q[wx].handle,str);
  90.      while q[wx].msg_first<>nill do begin
  91.        kopylst(q[wx].msg_first^.msg,str); mail_writeln(q[wx].handle,str);
  92.        p:=q[wx].msg_first^.link; dispara(q[wx].msg_first); q[wx].msg_first:=p;
  93.      end {while};
  94.  
  95.      {close file and clean up}
  96.      q[wx].msg_last:=nill; mail_close(q[wx].handle); q[wx].handle:=0;
  97.      if w^[wx].file_locked<>nill then w^[wx].file_locked^.msg:=null;
  98.  
  99.      {bump target's message count}
  100.      if encode(str,(ivalue(q[wx].your.mbx_count)+1):1)
  101.        then kopystr(str,q[wx].your.mbx_count);
  102.      dbp_member(q[wx].correspondent,q[wx].your)];
  103.  
  104.   sendmsg:=true;
  105. end {sendmsg};
  106.  
  107. {concatenate two paras, modifying the tail of the first}
  108. procedure nconc{var p1 : para; p2 : para};
  109. var
  110.   p : para;
  111. begin
  112.   if p1=nill then
  113.     p1:=p2
  114.   else
  115.     [p:=p1;
  116.      while p^.link<>nill do
  117.        p:=p^.link;
  118.      p^.link:=p2];
  119. end {nconc};
  120.  
  121. procedure ParaToMsg{t : integer; consts s : string; var b : para};
  122. var
  123.   p : para;
  124. begin
  125.   eval(disk2u(t)); q[wx].correspondent:=t;
  126.   prepare_header;
  127.   p:=newpara(ss[22]); concat(p^.msg,': '); {Subject: } konkat(p^.msg,s);
  128.   q[wx].msg_last^.link:=p; q[wx].msg_last:=p;
  129.   p:=newpara(null); q[wx].msg_last^.link:=p;
  130.   p^.link:=b; b:=nill;
  131. end {ParaToMsg};
  132.  
  133. procedure AppendPara2File{p : para; vars f : lstring};
  134. begin
  135.   if f=null then return;
  136.   q[wx].handle:=mult_open(f,0); {ignore control Zs}
  137.   if q[wx].handle>0 then
  138.     [while p<>nill do
  139.       [mail_writeln(q[wx].handle,p^.msg); p:=p^.link];
  140.      mail_close(q[wx].handle)];
  141.   if w^[wx].file_locked<>nill then w^[wx].file_locked^.msg:=null;
  142.   q[wx].handle:=0;
  143. end {AppendPara2File};
  144.  
  145. var beevirg : boolean;
  146. value beevirg := true;
  147. procedure spydump;
  148. var
  149.   l : integer;
  150. begin
  151.   if file_olog=null or else q[wx].xstr=nill
  152.     then return;
  153.   if beevirg then begin
  154.     f_log.trap:=true;
  155.     f_log.errs:=0;
  156.     assign(f_log,file_olog);
  157.     rewrite(f_log);
  158.     writeln(f_log,'Open Forum Log - ',mydate);
  159.     if f_log.errs<>0
  160.       then return;
  161.     beevirg:=false;
  162.   end {if};
  163.   f_log.errs:=0;
  164.   if q[wx].userid<10 then
  165.     l:=1
  166.   else if q[wx].userid<100 then
  167.     l:=2
  168.   else if q[wx].userid<1000 then
  169.     l:=3
  170.   else
  171.     l:=4;
  172.   writeln(f_log,mytime[1],mytime[2],mytime[4],mytime[5],' ',
  173.           q[wx].my.name:(9-l),' ',q[wx].userid:1,' ',q[wx].xstr^.msg);
  174. end {spydump};
  175.  
  176. {/P at a menu}
  177. procedure SlashP{consts s : lstring; var str : lstring};
  178. var
  179.   i : integer;
  180.   fl : boolean;
  181. begin
  182.   if q[wx].level<priv_gchat then
  183.     display(read_access_txt)
  184.   else
  185.     [delete(str,1,2);
  186.      for i:=1 to ord(str.len) do
  187.        if str[i]>'9' or else str[i]<'0' then
  188.      [str[0]:=chr(i-1); break];
  189.      fl:=false;
  190.      if str.len>0 and then ok2bother(str,i) and then
  191.     ((q[wx].level=9) or
  192.       ((q[i].logged_in) and
  193.        ((q[i].my.chat_ok[1]=' ') or
  194.         ((q[i].my.chat_ok[1]<>'P') and p2chatoff) or
  195.         gc(i)))) then
  196.     [fl:=true;
  197.      if q[wx].level=9 or else q[wx].userid<>q[i].squelch then
  198.        [if q[wx].xstr=nill
  199.           then q[wx].xstr:=newpara(s)
  200.           else kopylst(s,q[wx].xstr^.msg);
  201.         notify(i,gcl_txt);
  202.         spydump]];
  203.      if not fl then display(gcx2_txt)];
  204. end {SlashP};
  205.  
  206. END.
  207.